home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / TOOLS / PC_DEMO.ZIP / PIC_ASC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-15  |  4.6 KB  |  163 lines
  1. PROGRAM Pic_Asc;
  2. { CONVERTS PC-DEMO PICTURES TO ASCII FILES }
  3.  
  4.   CONST
  5.     Blank               = 32;       { ASCII OF SPACE CHARACTER}
  6.     Columns40           = 40;       { COLUMNS FROM 1 TO 40 }
  7.     Columns80           = 80;       { COLUMNS FROM 1 TO 80 }
  8.     LastLine            = 25;       { LINES 1 TO 25 }
  9.     MaxtString          = 76;       { MAX CHARS IN FILE NAME W/ PATH AND EXT }
  10.     FourKB              = 4000;     { FILE SIZE OF 80-COLUMN PICTURE }
  11.     TwoKB               = 2000;     { FILE SIZE OF 40-COLUMN PICTURE }
  12.     ASCIIExt            = '.ASC';   { FILE EXTENSION FOR ASCII FILES }
  13.     PictureExt          = '.PIC';   { FILE EXTENSION FOR FULL PICTURES }
  14.     Null                = '';       { NULL STRING }
  15.  
  16.   TYPE
  17.     N_PictureType       = ARRAY [1..LastLine, 1..Columns40] OF Integer;
  18.                                     { ARRAY OF 40-COLUMN PICTURE DATA }
  19.     W_PictureType       = ARRAY [1..LastLine, 1..Columns80] OF Integer;
  20.                                     { ARRAY OF 80-COLUMN PICTURE DATA }
  21.  
  22.     ParString           = String [255];
  23.                                     { VARIABLE LENGTH STRING PARAMETER TYPE }
  24.  
  25.   VAR
  26.     I,
  27.     LastChar,
  28.     LastColumn,
  29.     X,
  30.     Y                   : Byte;
  31.  
  32.     Size                : Integer;
  33.  
  34.     IName,
  35.     OName               : ParString;
  36.  
  37.     CurLine            : ARRAY [1..80] OF Char;
  38.  
  39.     W_Picture          : W_PictureType;
  40.                                     { THE 80-COLUMN PICTURE }
  41.  
  42.     N_Picture          : N_PictureType Absolute W_Picture;
  43.                                     { THE 40-COLUMN PICTURE }
  44.  
  45.     OutData             : Byte;
  46.  
  47.     N_InFile            : FILE OF N_PictureType;
  48.     W_InFile            : FILE OF W_PictureType;
  49.  
  50.     OutFile             : Text;
  51.  
  52.     TestFile            : FILE OF Byte;
  53.  
  54.  
  55.   FUNCTION Exist (FileName : ParString) : Boolean;
  56.   { SEES IF A FILE EXISTS }
  57.  
  58.     VAR
  59.       TestFile  : FILE;
  60.  
  61.     BEGIN    { Exist }
  62.       Assign (TestFile, FileName);
  63.  
  64. {$I-}
  65.  
  66.       Reset (TestFile);
  67.  
  68. {$I+}
  69.  
  70.       Exist := (IOResult = 0);
  71.       Close (TestFile);
  72.     END;     { Exist }
  73.  
  74.  
  75.  
  76.   PROCEDURE ConvertCase (VAR Strng : ParString);
  77.   { CONVERTS STRINGS TO UPPER CASE }
  78.  
  79.     VAR
  80.       I : Byte;
  81.  
  82.     BEGIN    { ConvertCase }
  83.       FOR I := 1 TO Length (Strng) DO
  84.         Strng [I] := UpCase (Strng [I]);
  85.     END;     { ConvertCase }
  86.  
  87.  
  88.   BEGIN    { Pic_Asc }
  89.     IName := Null;
  90.     IF ParamCount = 0
  91.       THEN
  92.         BEGIN
  93.           Writeln ('Command must be of form: PIC_ASC <name>');
  94.           Exit;
  95.         END;
  96.     IName := ParamStr (1);
  97.     Convertcase (IName);
  98.     OName := IName + ASCIIExt;
  99.     IName := IName + PictureExt;
  100.     IF NOT Exist (IName)
  101.       THEN
  102.        BEGIN
  103.          Writeln ('ERROR! File not found ' + IName);
  104.          Exit;
  105.        END;
  106.     Assign (TestFile, IName);
  107.     Reset (TestFile);
  108.     Size := FileSize (TestFile);
  109.     Close (TestFile);
  110.     IF NOT ((Size = TwoKB) OR (Size = FourKB))
  111.       THEN
  112.         BEGIN
  113.           Writeln ('ERROR! File wrong size.');
  114.           Exit;
  115.         END;
  116.     IF Size = TwoKB
  117.       THEN
  118.         BEGIN
  119.           LastColumn := Columns40;
  120.           Assign (N_InFile, IName);
  121.           Reset (N_InFile);
  122.           Read (N_InFile, N_Picture);
  123.           Assign (OutFile, OName);
  124.           Rewrite (OutFile);
  125.           FOR Y := 1 TO LastLine DO
  126.             BEGIN
  127.               LastChar := LastColumn + 1;
  128.               REPEAT
  129.                 LastChar := LastChar - 1;
  130.               UNTIL (Lo (N_Picture [Y, LastChar]) <> Blank) OR
  131.                     (LastChar = 0);
  132.               FOR X := 1 TO LastChar DO
  133.                 Write (OutFile, Chr (Lo (N_Picture [Y, X])));
  134.               Writeln (OutFile);
  135.             END;
  136.           Close (N_InFile);
  137.           Close (OutFile);
  138.         END
  139.       ELSE
  140.         BEGIN
  141.           LastColumn := Columns80;
  142.           Assign (W_InFile, IName);
  143.           Reset (W_InFile);
  144.           Read (W_InFile, W_Picture);
  145.           Assign (OutFile, OName);
  146.           Rewrite (OutFile);
  147.           FOR Y := 1 TO LastLine DO
  148.             BEGIN
  149.               LastChar := LastColumn + 1;
  150.               REPEAT
  151.                 LastChar := LastChar - 1;
  152.               UNTIL (Lo (W_Picture [Y, LastChar]) <> Blank) OR
  153.                     (LastChar = 0);
  154.               FOR X := 1 TO LastChar DO
  155.                 Write (OutFile, Chr (Lo (W_Picture [Y, X])));
  156.               Writeln (OutFile);
  157.             END;
  158.           Close (W_InFile);
  159.           Close (OutFile);
  160.         END;
  161.       Writeln ('File ' + OName + ' created');
  162.     END.     { Pic_Asc }
  163.